MacHack 1996/MacHack 1996.toast/Presentations/Presentations ’96/Papers ’96/Scripting⁄Bare Bones/Scripting.p (for MacHack)

Text File | 1996-01-01 | 38.5 KB | 1,254 lines | [TEXT/PJMM]

{This is a unit to add support for scriptability to an application.}
{Presented at MacHack '96, by Kevin Killion}

{--------------------------------------------------------------------------------------------------}

{©Copyright 1996, Stone House Systems, Inc.  Written by Kevin C. Killion.}

{This listing may NOT be reproduced or distributed by anyone for purposes of publication,}
{distribution, compilation in a collection of source code examples, or any other purposes,}
{except by written agreement with Stone House Systems, Inc. Our e-mail address is}
{[e-mail], and our phone is [phone]. }

{--------------------------------------------------------------------------------------------------}

{Portions of this listing are derived from Quill, written by Bennet Marks and Copyright © 1991 Apple Computer, Inc.}
{In turn, Quill was based on TEStyleSample  (Copyright © 1989 Apple Computer, Inc.)}

{--------------------------------------------------------------------------------------------------}

{Notes and quirks:}

{This unit is excerpted directly from a "real" application written in TCL, and some vestigal remains of that app are }
{still present.  In particular, reference is made to a some other units and classes: }
{ Some classes:}
{KTHISAPPDoc: a subclass of CDocument }
{KRow: corresponding to rows in a document }

{The CHATTY compiler switch sets whether we want extra info for debugging}

{--------------------------------------------------------------------------------------------------}

UNIT Scripting;

INTERFACE

CONST
    errAECantHandleClass = -10010;
    errAECantHandleType = -10009;
    errAENotAnElement = -10008;
    errAEIndexTooLarge = -10007;
    errAENotModifiable = -10003;
    errAEBadKeyForm = -10002;

{--------------------------------------------------------------------------------------------------}

IMPLEMENTATION

{$SETC CHATTY=FALSE}

USES
    AEObjects, THISAPPIntf, KTHISAPPCommands;

CONST
    errorStringID = 9001;

    eOnlyFirstOrLast = 1;                        {Only "first" or "last" may be used as keywords here}
    eOnlyNameOrIndex = 2;                        {This object can only be referred to by name or index}
    eOnlyNameIndexFirstOrLast = 3;                {This class can only be referenced by name, index, "first" or "last'}
    eOnlyIndexFirstOrLast = 4;                    {This class can only be referenced by index, "first" or "last"}
    eIndexNumberOutOfRange = 5;                    {Index number given is out of range of existing objects}
    eContainerDoesNotContainRequestedClass = 10;        {Container does not contain requested class}
    eContainerDoesNotHaveValidToken = 11;            {Container does not have valid token}

    eElementIsNotMemberOfSpecifiedContainer = 15;    {Element is not member of specified container}

    eBufferTooSmall = 20;                        {Cannot handle this property (internal buffer too small)}
    eCannotHandleAPropertyOfThisType = 21;            {Cannot handle a property of this type}
    ePropertyValueSpecifiedInIncorrectFormat = 22;    {Property value specified in incorrect format}
    ePropertyValueSpecifiedWithIncorrectSize = 23;    {Property value specified with incorrect size}

    eThisClassUnderConstruction = 30;                    {This class under construction}
    eThisPropertyUnderConstruction = 31;                {This property under construction}
    eCannotHandlePropertiesOfThisClass = 32;            {Cannot handle properties of this class}

    cProperty = 'prop';
    kAECoreSuite = 'core';
    kAECountElements = 'cnte';
    kAEGetData = 'getd';
    kAESetData = 'setd';
    keyAEObjectClass = 'kocl';
    keyAEResult = '----';                {also, keyDirectObject = '----';}
    keyAERequestedType = 'rtyp';
    keyAEErrorObject = 'erob';
    keyAEData = 'data';
    genericErr = -1799;

TYPE
    LongPointer = ^longint;
    LongHandle = ^LongPointer;

    {Everyone gets to decide for himself/herself what a "token" consists of.}
    {Here's what I chose, for this application}
    MyTokenType = RECORD
            myTokenCode: DescType;    {a code used only by app internally}
            theObject: CObject;
            subReference: longint;    {if an element of an object is not a "real" object, this is useful}
            isAProperty: Boolean;    {if FALSE, this is an object itself; if TRUE, it refers to a property of that object}
            propertyCode: DescType;    {A code defined in aete.  Field is only used if isAProperty=TRUE}
        END;

CONST
    myTokenSize = SIZEOF(MyTokenType);

        {codes used in myTokenCode}
    winTokenCode = '*win';
    docTokenCode = '*doc';
    rowTokenCode = '*row';

VAR
    gErrorDesc: AEDesc;
    gNullDesc: AEDesc;
    gInHandler, gTempBool: Boolean;
    gReturnedKeywd: AEKeyWord;
    gReturnedType: DescType;
    gActSize: Size;

    aTokenBody: MyTokenType;

FUNCTION CheckErr (errResult, where: integer): Boolean;
    VAR
        item: integer;
    BEGIN
        IF errResult <> noErr THEN
            BEGIN
                ParamText('CheckErr:  err ', N2S(errResult), ' has occurred at ', N2S(where));
                item := NoteAlert(7500, NIL);
                {error "errResult" has occured at "where" in the program}
            END;

        CheckErr := (errResult <> noErr);
    END;


FUNCTION CatchErr (errResult, where: integer; VAR errToBeReturned: integer): Boolean;
    BEGIN
        errToBeReturned := errResult;
        CatchErr := CheckErr(errResult, where);
    END;


FUNCTION QuietCatchErr (theErr: OSErr; VAR holdErr: OSErr): BOOLEAN;
{ this routine returns TRUE if theErr is a real error (not}
{  noErr), FALSE if noErr.  In either case it stuffs theErr}
{  into the VAR parameter holdErr for later use, which can}
{  be particularly handy if the first parameter is an error-}
{  generating function (like all the AE calls).  Unlike}
{  CatchErr, QuietCatchErr does not put up an error alert.}
{  INPUTS:    theErr        potential error to be checked}
{              holdERR        result VAR to save the error code in}
    BEGIN
        holdErr := theErr;
        QuietCatchErr := (theErr <> noErr);
    END;


PROCEDURE DisplayParameterInfo (ae: AppleEvent; desiredType: AEKeyword);
    VAR
        actualType: DescType;
        actualSize: Size;
        debugString: str255;
        err, item: integer;
    BEGIN
        err := AESizeOfParam(ae, desiredType, actualType, actualSize);
        debugString := STRINGOF('How was the data supplied?  Type=“', actualType, '”, size=“', actualSize : 1, '”, error=', err : 1);
        ParamText(debugString, '', '', '');
        item := NoteAlert(7500, NIL);
    END;

{------------------------------------------------------------------------------------------------}

PROCEDURE PreHandler;        { called at the start of every AppleEvent handler}
    BEGIN
        gInHandler := TRUE;
        gErrorDesc := gNullDesc;
    END;


PROCEDURE PostHandler (reply: AppleEvent; errNum: OSErr);
{    reply        the reply AppleEvent in which the handler}
{                          should return any error parameters; may be}
{                        typeNull if the sender didn't ask for a reply}
{    myErr        the error code generated by the handler (may be noErr)}
    VAR
        errDescExists: boolean;
        sss: str255;
        e: integer;
    BEGIN
        gInHandler := FALSE;

        errDescExists := (gErrorDesc.descriptorType <> typeNull);

        IF (reply.descriptorType <> typeNull) & (errNum <> noErr) & errDescExists THEN
              { they want a reply; there was an error; there's an object in gErrorDesc - so send it back with the reply    }
            gTempBool := CheckErr(AEPutParamDesc(reply, keyAEErrorObject, gErrorDesc), 21313);

        { in any case, if there is a gErrorDesc, now's a good time to get rid of it }
        IF errDescExists THEN
            BEGIN
                gTempBool := CheckErr(AEDisposeDesc(gErrorDesc), 21314);
                gErrorDesc := gNullDesc;    { just for neatness }
            END;

        IF errNum <> noErr THEN
            IF reply.dataHandle <> NIL THEN
                IF (errNum > 0) & (errNum <= CountIndStr(errorStringID)) THEN
                    BEGIN
                        GetIndString(sss, errorStringID, errNum);
                        IF sss <> '' THEN
                            e := AEPutParamPtr(reply, keyErrorString, typeChar, @sss[1], LENGTH(sss));
                    END;

    END;    { PostHandler }


{ set a bunch of descriptors to the null descriptor}
PROCEDURE InitSomeDescs (desc1Ptr, desc2Ptr, desc3Ptr, desc4Ptr, desc5Ptr: DescPtr);
    BEGIN
        IF desc1Ptr <> NIL THEN
            desc1Ptr^ := gNullDesc;
        IF desc2Ptr <> NIL THEN
            desc2Ptr^ := gNullDesc;
        IF desc3Ptr <> NIL THEN
            desc3Ptr^ := gNullDesc;
        IF desc4Ptr <> NIL THEN
            desc4Ptr^ := gNullDesc;
        IF desc5Ptr <> NIL THEN
            desc5Ptr^ := gNullDesc;
    END;


FUNCTION DisposeSomeDescs (desc1Ptr, desc2Ptr, desc3Ptr, desc4Ptr, desc5Ptr: DescPtr): OSErr;
    LABEL
        9;
    VAR
        myErr: OSErr;
        tempErr: OSErr;
    BEGIN
        myErr := noErr;
        IF desc1Ptr = NIL THEN
            GOTO 9;    { finish up }
        myErr := AEDisposeDesc(desc1Ptr^);

        IF desc2Ptr = NIL THEN
            GOTO 9;
        tempErr := AEDisposeDesc(desc2Ptr^);
        IF myErr = noErr THEN
            myErr := tempErr;    { we want to keep the first real error }

        IF desc3Ptr = NIL THEN
            GOTO 9;
        tempErr := AEDisposeDesc(desc3Ptr^);
        IF myErr = noErr THEN
            myErr := tempErr;

        IF desc4Ptr = NIL THEN
            GOTO 9;
        tempErr := AEDisposeDesc(desc4Ptr^);
        IF myErr = noErr THEN
            myErr := tempErr;

        IF desc5Ptr = NIL THEN
            GOTO 9;
        tempErr := AEDisposeDesc(desc5Ptr^);
        IF myErr = noErr THEN
            myErr := tempErr;

9:    { finish up }
        DisposeSomeDescs := myErr;
    END;


FUNCTION GotRequiredParams (theAppleEvent: AppleEvent): OSErr;
{ checks the AppleEvent to see if we've gotten all the required parameters}
    VAR
        myErr: OSErr;
        returnedType: DescType;
        actSize: Size;
    BEGIN
  { look for the keyMissedKeywordAttr, just to see if it's there }
        myErr := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, NIL, 0, actSize);
        IF myErr = errAEDescNotFound THEN
            GotRequiredParams := noErr            { attribute not there means we got all req params }
        ELSE IF myErr = noErr THEN
            GotRequiredParams := errAEParamMissed        { attribute there means missed at least one }
        ELSE
            GotRequiredParams := myErr;    { some unexpected arror in looking for the attribute }
    END;

{------------------------------------------------------------------------------------------------}

    TYPE
        propActionType = (propGet, propSet);


FUNCTION TransferProperty (propAction: propActionType; propPtr: ptr; kind: char; lenProp: integer; writeable: Boolean; ae: AppleEvent): OSErr;
    LABEL
        99;
    CONST
        difficult = '????';
    VAR
        descriptor, actualType: DescType;
        buffer: PACKED ARRAY[0..511] OF char;
        err: OSErr;
        strlen, dbx: integer;
        actualSize: Size;
        debugString: str255;
    BEGIN
        IF (kind = 'I') & (lenProp = 2) THEN
            descriptor := typeShortInteger
        ELSE IF (kind = 'I') & (lenProp = 4) THEN
            descriptor := typeLongInteger
        ELSE IF (kind = 'R') & (lenProp = 4) THEN
            descriptor := typeShortFloat
        ELSE IF (kind = 'R') & (lenProp = 8) THEN
            descriptor := typeLongFloat
        ELSE
            descriptor := difficult;    {anything else:  strings, booleans, extended, fileSpec}

    {GET DATA}

        IF propAction = propGet THEN
            BEGIN
                {get the value of the specified property}
                IF lenProp <= SIZEOF(buffer) THEN
                    BlockMove(propPtr, @buffer, lenProp)        {put the contents of the property into the buffer}
                ELSE
                    BEGIN
                        err := eBufferTooSmall;
                        GOTO 99;
                    END;

                {stuff the value into the AppleEvent}
                IF descriptor <> difficult THEN
                    err := AEPutParamPtr(ae, keyDirectObject, descriptor, @buffer, lenProp)
                ELSE IF kind = 'S' THEN
                    BEGIN
                        strlen := ORD(buffer[0]);
                        err := AEPutParamPtr(ae, keyDirectObject, typeChar, @buffer[1], strlen);
                    END
                ELSE
                    err := eCannotHandleAPropertyOfThisType;
            END

    {SET DATA}

        ELSE IF propAction = propSet THEN
            BEGIN
                IF NOT writeable THEN
                    BEGIN
                        err := errAENotModifiable;
                        GOTO 99;
                    END;

                {retrieve the new value from the AppleEvent}
                IF kind = 'S' THEN
                    BEGIN
                        err := AEGetParamPtr(ae, keyAEData, typeChar, actualType, @buffer[1], SIZEOF(buffer) - 1, actualSize);
                        IF err = noErr THEN
                            BEGIN
                                strlen := actualSize;
                                IF strlen > 255 THEN
                                    strlen := 255;
                                buffer[0] := CHR(strlen);

                                IF (strlen + 1) > lenProp THEN    {too big to fit in a string structure this size}
                                    BEGIN
                                        strlen := lenProp - 1;
                                        buffer[0] := CHR(strlen);
                                    END;

                                BlockMove(@buffer, propPtr, strlen + 1);
                            END;
                    END
                ELSE IF descriptor <> difficult THEN
                    BEGIN
                        {DisplayParameterInfo(ae, keyAEData);}
                        err := AEGetParamPtr(ae, keyAEData, descriptor, actualType, @buffer, SIZEOF(buffer), actualSize);
                        IF err = noErr THEN
                            BEGIN
                                IF descriptor <> actualType THEN    {we didn't get what we wanted}
                                    err := ePropertyValueSpecifiedInIncorrectFormat
                                ELSE IF lenProp <> actualSize THEN
                                    err := ePropertyValueSpecifiedWithIncorrectSize;

{$IFC TRUE}
                                IF err <> noErr THEN
                                    BEGIN
                                        ParamText(descriptor, N2S(lenProp), actualType, N2S(actualSize));
                                        dbx := NoteAlert(7502, NIL);
                                        debugString := STRINGOF(ORD(buffer[0]) : 1, ' ', ORD(buffer[1]) : 1, ' ', ORD(buffer[2]) : 1, ' ', ORD(buffer[3]) : 1, ' ', ORD(buffer[4]) : 1, ' ', ORD(buffer[5]) : 1, ' ', ORD(buffer[6]) : 1, ' ', ORD(buffer[7]) : 1, ' ', ORD(buffer[8]) : 1, ' ', ORD(buffer[9]) : 1);
                                        ParamText('TransferProperty, Set Data:  the first few values in the buffer are: ', debugString, '', '');
                                        dbx := NoteAlert(7500, NIL);
                                    END;
{$ENDC}
                            END;

                        IF err = noErr THEN    {everything looks good, so revise the property itself!}
                            BlockMove(@buffer, propPtr, lenProp);
                    END
                ELSE
                    err := eCannotHandleAPropertyOfThisType;
            END;

99:
        TransferProperty := err;

{$IFC CHATTY}
        ParamText('TransferProperty, return err = ', N2S(err), '', '');
        IF NoteAlert(7500, NIL) = 1 THEN
            ;
{$ENDC}
    END;


FUNCTION DoTransferProperty (propAction: propActionType; VAR myToken: MyTokenType; ae: AppleEvent): OSErr;
    VAR
        obj: CObject;
        thisRow: KRow;
        doc: KTHISAPPDoc;
        err: OSErr;
        oldLock, recalc: Boolean;
        prop: DescType;
        sss: str255;
    BEGIN
        prop := myToken.propertyCode;
        obj := myToken.theObject;
        oldLock := obj.Lock(TRUE);
        recalc := FALSE;

    {APPLICATION}
        IF myToken.myTokenCode = typeNull THEN
            BEGIN
                IF prop = 'pnam' THEN
                    err := TransferProperty(propAction, @gAppName, 'S', SIZEOF(gAppName), FALSE, ae)
                ELSE IF prop = 'pcli' THEN
                    BEGIN
                        IF gClipboard.GetString(sss) THEN
                            err := TransferProperty(propAction, @sss, 'S', SIZEOF(sss), FALSE, ae);
                    END
                ELSE IF prop = 'vers' THEN
                    BEGIN
                        sss := '«Version number should be determined here»';
                        err := TransferProperty(propAction, @sss, 'S', SIZEOF(sss), FALSE, ae);
                    END
                ELSE
                    err := eThisPropertyUnderConstruction;
            END

    {WINDOW}
        ELSE IF myToken.myTokenCode = winTokenCode THEN
            err := eThisClassUnderConstruction

    {DOCUMENT}
        ELSE IF myToken.myTokenCode = docTokenCode THEN    {handle doc properties for THIS APP!}
            BEGIN
                doc := KTHISAPPDoc(obj);

                IF prop = 'tgrp' THEN
                    err := TransferProperty(propAction, @doc.docgrp, 'R', SIZEOF(doc.docgrp), FALSE, ae)
                ELSE IF prop = 'ggrp' THEN
                    err := TransferProperty(propAction, @doc.docgoalgrp, 'R', SIZEOF(doc.docgoalgrp), FALSE, ae)
                ELSE IF prop = 'tcst' THEN
                    err := TransferProperty(propAction, @doc.doccost, 'R', SIZEOF(doc.doccost), FALSE, ae)
                ELSE IF prop = 'tbud' THEN
                    err := TransferProperty(propAction, @doc.docbudget, 'R', SIZEOF(doc.docbudget), FALSE, ae)
                ELSE IF prop = 'tins' THEN
                    err := TransferProperty(propAction, @doc.docUnits, 'R', SIZEOF(doc.docUnits), FALSE, ae)
                ELSE IF prop = '*gwt' THEN
                    err := TransferProperty(propAction, @doc.geoWeight, 'R', SIZEOF(doc.geoWeight), FALSE, ae)
                ELSE
                    err := eThisClassUnderConstruction;
            END

    {ROWS}
        ELSE IF myToken.myTokenCode = rowTokenCode THEN    {handle row properties for THIS APP!}
            BEGIN
                thisRow := KRow(obj);

                IF prop = '*mht' THEN
                    err := TransferProperty(propAction, @thisRow.height, 'I', SIZEOF(thisRow.height), TRUE, ae)
                ELSE IF prop = 'flpt' THEN
                    err := TransferProperty(propAction, @thisRow.fillPat, 'I', SIZEOF(thisRow.fillPat), TRUE, ae)
                ELSE IF prop = 'pppa' THEN
                    err := TransferProperty(propAction, @thisRow.linePat, 'I', SIZEOF(thisRow.linePat), TRUE, ae)
                ELSE IF prop = 'flcl' THEN
                    err := TransferProperty(propAction, @thisRow.fillCol, 'I', SIZEOF(thisRow.fillCol), TRUE, ae)
                ELSE IF prop = 'ppcl' THEN
                    err := TransferProperty(propAction, @thisRow.lineCol, 'I', SIZEOF(thisRow.lineCol), TRUE, ae)
                ELSE IF prop = 'ppwd' THEN
                    err := TransferProperty(propAction, @thisRow.lineThick, 'I', SIZEOF(thisRow.lineThick), TRUE, ae)
                ELSE IF prop = 'pnam' THEN
                    err := TransferProperty(propAction, PTR(thisRow.title^), 'S', SIZEOF(thisRow.title^^), TRUE, ae)
                ELSE IF prop = 'desc' THEN
                    err := TransferProperty(propAction, PTR(thisRow.subtitle^), 'S', SIZEOF(thisRow.subtitle^^), TRUE, ae)
                ELSE IF prop = 'twks' THEN
                    err := TransferProperty(propAction, @thisRow.nweeks, 'I', SIZEOF(thisRow.nweeks), FALSE, ae)
                ELSE IF prop = 'tgrp' THEN
                    err := TransferProperty(propAction, @thisRow.mgrp, 'R', SIZEOF(thisRow.mgrp), FALSE, ae)
                ELSE IF prop = 'ggrp' THEN
                    err := TransferProperty(propAction, @thisRow.mgoalgrp, 'R', SIZEOF(thisRow.mgoalgrp), FALSE, ae)
                ELSE IF prop = 'tcst' THEN
                    err := TransferProperty(propAction, @thisRow.mcost, 'R', SIZEOF(thisRow.mcost), FALSE, ae)
                ELSE IF prop = 'tbud' THEN
                    err := TransferProperty(propAction, @thisRow.mbudget, 'R', SIZEOF(thisRow.mbudget), FALSE, ae)
                ELSE IF prop = 'tins' THEN
                    err := TransferProperty(propAction, @thisRow.mUnits, 'R', SIZEOF(thisRow.mUnits), FALSE, ae)
                ELSE IF prop = '*gwt' THEN
                    err := TransferProperty(propAction, @thisRow.geoWeight, 'R', SIZEOF(thisRow.geoWeight), FALSE, ae)
                ELSE
                    err := eThisPropertyUnderConstruction;

                IF (propAction = propSet) & (err = noErr) THEN
                    thisRow.Refresh;
            END


        ELSE
            err := eCannotHandlePropertiesOfThisClass;

        oldLock := obj.Lock(oldLock);
        DoTransferProperty := err;
    END;

{------------------------------------------------------------------------------------------------}

FUNCTION HandleGetData (theAppleEvent: AppleEvent; reply: AppleEvent; handlerRefCon: LongInt): OSErr;
    LABEL
        9;
    VAR
        myToken: MyTokenType;
        item: integer;
        siz: longint;
        err: OSErr;
        myDirObj: AEDesc;
        reqType: DescType;
        reqTypesList: AEDesc;
        newDesc: AEDesc;
        notToken: BOOLEAN;    { really, we ignore this one }
        dataDesc: AEDesc;
    BEGIN
{$IFC CHATTY}
        ParamText('HandleGetData', ' - START', '', '');
        item := NoteAlert(7500, NIL);
{$ENDC}

        PreHandler;
        err := errAEEventNotHandled;
        InitSomeDescs(@myDirObj, @dataDesc, @reqTypesList, NIL, NIL);

  { pick up the direct object }

        IF CatchErr(AEGetParamDesc(theAppleEvent, keyDirectObject, typeWildCard, myDirObj), 14613, err) THEN
            GOTO 9;    { finish up }

  { get a requested return type list, if any }
        err := AEGetParamPtr(theAppleEvent, keyAERequestedType, typeAEList, gReturnedType, @reqType, SizeOf(reqType), gActSize);

  { NOTE: all lower-level routines treat a reqTypesList of typeNull as though it }
  { were a 1-element list containing typeWildCard, so we don't have to hoke up   }
  { a 1-element list here                                                        }

        IF err = errAEDescNotFound THEN
            err := noErr
        ELSE IF err <> noErr THEN    { unexpected problem while trying to get param }
            BEGIN
                gTempBool := CheckErr(err, 14614);
                GOTO 9;
            END;

  { check for required parameters }
        IF CatchErr(GotRequiredParams(theAppleEvent), 14615, err) THEN
            GOTO 9;

    {RESOLVE}
        IF CatchErr(AEResolve(myDirObj, kAEIDoMinimum, newDesc), 14620, err) THEN
            GOTO 9;
        BlockMove(newDesc.dataHandle^, @myToken, myTokenSize);

{$IFC CHATTY}
        ParamText('RESOLVED!  my token code is ', myToken.myTokenCode, ', propertyCode is ', myToken.propertyCode);
        item := NoteAlert(7500, NIL);
{$ENDC}

    {GET THE DESIRED PROPERTY, AND RETURN IT}
        err := DoTransferProperty(propGet, myToken, reply);


9:    { finish up }

        gTempBool := CheckErr(DisposeSomeDescs(@myDirObj, @dataDesc, @reqTypesList, NIL, NIL), 14619);
        HandleGetData := err;
        PostHandler(reply, err);

{$IFC CHATTY}
        ParamText('HandleGetData', ' - DONE', '', '');
        item := NoteAlert(7500, NIL);
{$ENDC}
    END;


FUNCTION HandleSetData (theAppleEvent: AppleEvent; reply: AppleEvent; handlerRefCon: LongInt): OSErr;
    LABEL
        9;
    VAR
        myToken: MyTokenType;
        item: integer;
        err: OSErr;
        myDirObj: AEDesc;
        myDataDesc: AEDesc;
        newDesc: AEDesc;
    BEGIN
{$IFC CHATTY}
        ParamText('HandleSetData', ' - START', '', '');
        item := NoteAlert(7500, NIL);
{$ENDC}

        PreHandler;
        err := errAEEventNotHandled;
        InitSomeDescs(@myDirObj, @myDataDesc, @newDesc, NIL, NIL);

  { pick up the direct object, which is the object whose data is to be set }
        IF CatchErr(AEGetParamDesc(theAppleEvent, keyDirectObject, typeWildCard, myDirObj), 15013, err) THEN
            GOTO 9;    { finish up }


    {RESOLVE}
        IF CatchErr(AEResolve(myDirObj, kAEIDoMinimum, newDesc), 15017, err) THEN
            GOTO 9;
        BlockMove(newDesc.dataHandle^, @myToken, myTokenSize);

    {GET THE DESIRED PROPERTY, AND SET IT, according to data contents of the AppleEvent}
        err := DoTransferProperty(propSet, myToken, theAppleEvent);


9:    { finish up }
        gTempBool := CheckErr(DisposeSomeDescs(@myDirObj, @myDataDesc, @newDesc, NIL, NIL), 15020);

        HandleSetData := err;
        PostHandler(reply, err);

{$IFC CHATTY}
        ParamText('HandleSetData', ' - DONE', '', '');
        item := NoteAlert(7500, NIL);
{$ENDC}
    END;

{------------------------------------------------------------------------------------------------}

FUNCTION MyAECoerceDescPtr (theAEDesc: AEDesc; toType: DescType; dataPtr: Ptr; maximumSize: Size; VAR actualSize: Size): OSErr;
{ this routine plugs a hole that's been nagging at me in the AppleEvents}
{  interface.  It takes a descriptor and coerces it to a desired type; but}
{  instead of returning a descriptor, it returns data in a buffer specified}
{  by the caller.}
{  INPUTS:    theAEDesc        descriptor to be coerced}
{              toType            type to coerce it to}
{            dataPtr            ptr to data buffer}
{            maximumSize        maximum length in bytes of data to be returned}
{            actualSize        actual length in bytes of data for the descriptor}
{  OUTPUTS:    error code (noErr if none)}
{  ERRORS:}
{  SIDE EFFECTS:}
{  NOTES:    12/16/91    BHM        (1) Changed to avoid unecessary duplication when the type}
{                                  doesn't really change (this should also enable it to handle}
{                                typeWildCard better)}
{                                (2) We don't need to dispose of newDesc because it is a direct}
{                                copy (not a duplicate) of either theAEDesc or resultDesc - that}
{                                is, it contains the same handle}
{}
    LABEL
        9;
    VAR
        myErr: INTEGER;
        newDesc: AEDesc;
        resultDesc: AEDesc;
        transferSize: Size;
    BEGIN
        myErr := errAECoercionFail;
        resultDesc := gNullDesc;

  { to avoid unnecessary duplication, check old type vs. new type }
        IF (theAEDesc.descriptorType = toType) OR (toType = typeWildCard) THEN
            newDesc := theAEDesc
        ELSE
            BEGIN    { must coerce to new type }
                IF QuietCatchErr(AECoerceDesc(theAEDesc, toType, resultDesc), myErr) THEN
                    GOTO 9;
                newDesc := resultDesc;
            END;

        WITH newDesc DO
            BEGIN { get the size }
                actualSize := GetHandleSize(dataHandle);
                IF QuietCatchErr(MemError, myErr) THEN
                    GOTO 9;

                { calculate number of bytes to move }
                transferSize := actualSize;
                IF maximumSize < transferSize THEN
                    transferSize := maximumSize;

                { move the data }
                HLock(dataHandle);
                BlockMove(dataHandle^, dataPtr, transferSize);
                HUnlock(dataHandle);
            END;    { of WITH newDesc }

  { everything fine }
        myErr := noErr;

9:    { finish up }
        gTempBool := CheckErr(AEDisposeDesc(resultDesc), 2215);
        MyAECoerceDescPtr := myErr;
    END;


FUNCTION TextDescToStr (textDesc: AEDesc; VAR destStr: Str255; VAR actSize: Size): OSErr;
{ this routine takes a descriptor that contains text information}
{  (basically, anything that can be coerced to typeChar) and copies}
{  the text into a Pascal string.  The text will be truncated to 255 }
{  characters, if necessary; the actual size of the original text will}
{  also be returned.}
{  INPUTS:    textDesc    the descriptor containing the text}
{              destStr        return VAR for the string}
{            actSize        return VAR for the actual text length}
{  OUTPUTS:    error code (noErr if none).  Truncation is not an error.}
    LABEL
        9;
    VAR
        myErr: OSErr;
        destStrPtr: Ptr;
        xferSize: Size;
    BEGIN
        myErr := genericErr;
        actSize := 0;
        destStr := 'bad string';

        destStrPtr := Ptr(ORD4(@destStr) + 1);
        IF CatchErr(MyAECoerceDescPtr(textDesc, typeChar, destStrPtr, 255, actSize), 9013, myErr) THEN
            GOTO 9;    { set function result }

        xferSize := actSize;
        IF xferSize > 255 THEN
            xferSize := 255;
        destStrPtr := @destStr;
        destStrPtr^ := xferSize;

        myErr := noErr;

9:    { set function result }
        TextDescToStr := myErr;
    END;


FUNCTION AppObjectAccessor (desiredClass: DescType; containerToken: AEDesc; keyForm: DescType; keyData: AEDesc; VAR theTokenBody: MyTokenType): OSErr;
    VAR
        err, numDocs: integer;
        actSize: Size;
        wantedName, sss: str255;
        wantedIndex: longint;
        w: WindowPeek;
        obj: CObject;
        found: Boolean;
    PROCEDURE Bail (bailErr: integer);
        BEGIN
            AppObjectAccessor := bailErr;
            EXIT(AppObjectAccessor);
        END;
    BEGIN
        IF (desiredClass = 'cwin') | (desiredClass = 'docu') THEN
            BEGIN
                IF keyForm = formName THEN
                    BEGIN
                        IF CatchErr(TextDescToStr(keyData, wantedName, actSize), 1915, err) THEN
                            Bail(err);
                    END

                ELSE IF keyForm = formAbsolutePosition THEN
                    BEGIN
                        numDocs := 0;
                        w := WindowPeek(FrontWindow);
                        WHILE w <> NIL DO
                            BEGIN
                                IF w^.windowKind = OBJ_WINDOW_KIND THEN
                                    BEGIN
                                        obj := CWindow(GetWRefCon(WindowPtr(w)));
                                        IF Member(CBureaucrat(obj).itsSupervisor, KTHISAPPDoc) THEN
                                            numDocs := numDocs + 1;
                                    END;
                                w := w^.nextWindow;
                            END;

                        wantedIndex := LongHandle(keyData.dataHandle)^^;
                        IF keyData.descriptorType = typeLongInteger THEN
                            BEGIN
                                IF wantedIndex <= 0 THEN
                                    wantedIndex := numDocs + wantedIndex + 1;
                            END
                        ELSE IF keyData.descriptorType = typeAbsoluteOrdinal THEN
                            BEGIN
                                IF wantedIndex = LONGINT(kAEFirst) THEN
                                    wantedIndex := 1
                                ELSE IF wantedIndex = LONGINT(kAELast) THEN
                                    wantedIndex := numDocs
                                ELSE
                                    Bail(eOnlyFirstOrLast);
                            END
                        ELSE
                            Bail(eOnlyNameIndexFirstOrLast);

                        IF (wantedIndex < 1) | (wantedIndex > numDocs) THEN
                            Bail(eIndexNumberOutOfRange);
                    END
                ELSE
                    Bail(eOnlyNameOrIndex);

                        {we now know what is wanted, let's loop through and see if we can find it}
                numDocs := 0;
                found := FALSE;
                w := WindowPeek(FrontWindow);
                WHILE (w <> NIL) & (NOT found) DO
                    BEGIN
                        IF w^.windowKind = OBJ_WINDOW_KIND THEN
                            BEGIN
                                obj := CWindow(GetWRefCon(WindowPtr(w)));
                                IF Member(CBureaucrat(obj).itsSupervisor, KTHISAPPDoc) THEN
                                    BEGIN
                                        numDocs := numDocs + 1;
                                        IF keyForm = formAbsolutePosition THEN
                                            found := (numDocs = wantedIndex)
                                        ELSE IF keyForm = formName THEN
                                            BEGIN
                                                CWindow(obj).GetTitle(sss);
                                                found := (sss = wantedName);
                                            END;

                                        IF found THEN
                                            BEGIN
                                                IF desiredClass = 'cwin' THEN
                                                    BEGIN
                                                        theTokenBody.myTokenCode := winTokenCode;
                                                        theTokenBody.theObject := CObject(obj);
                                                    END
                                                ELSE IF desiredClass = 'docu' THEN
                                                    BEGIN
                                                        theTokenBody.myTokenCode := docTokenCode;
                                                        theTokenBody.theObject := CObject(CBureaucrat(obj).itsSupervisor);
                                                    END;
                                                theTokenBody.subReference := 0;
                                                theTokenBody.isAProperty := FALSE;
                                                Bail(noErr);
                                            END;
                                    END;
                            END;
                        w := w^.nextWindow;
                    END;

                {fell thru the loop without success}
                Bail(errAENoSuchObject);
            END
        ELSE
            Bail(eContainerDoesNotContainRequestedClass);
    END;


FUNCTION GetTokenFromAEDesc (ref: char; theAEDesc: AEDesc; VAR theToken: MyTokenType): Boolean;
    VAR
        gotIt: Boolean;
        sss: str255;
        siz: longint;
    BEGIN
        gotIt := FALSE;
        IF theAEDesc.descriptorType <> typeNull THEN
            IF theAEDesc.dataHandle <> NIL THEN
                IF GetHandleSize(theAEDesc.dataHandle) = myTokenSize THEN
                    BEGIN
                        BlockMove(theAEDesc.dataHandle^, @theToken, myTokenSize);
                        gotIt := TRUE;
                    END;

{$IFC CHATTY}
        IF NOT gotIt THEN
            BEGIN
                sss := STRINGOF(ref, '—GetTokenFromAEDesc:  type “', theAEDesc.descriptorType);
                IF theAEDesc.dataHandle = NIL THEN
                    ParamText(sss, '”, handle NIL', '', '')
                ELSE
                    ParamText(sss, '”, handle  size ', N2S(GetHandleSize(theAEDesc.dataHandle)), '');
                IF NoteAlert(7500, NIL) = 1 THEN
                    ;

                siz := GetHandleSize(theAEDesc.dataHandle);
                IF siz <= 255 THEN
                    BEGIN
                        BlockMove(theAEDesc.dataHandle^, @sss[1], siz);
                        sss[0] := CHR(siz);
                        ParamText('Contents of that handle as a string: “', sss, '”', '');
                        IF NoteAlert(7500, NIL) = 1 THEN
                            ;
                    END;
            END;
{$ENDC}

        GetTokenFromAEDesc := gotIt;
    END;


FUNCTION DocObjectAccessor (desiredClass: DescType; containerToken: AEDesc; keyForm: DescType; keyData: AEDesc; VAR theTokenBody: MyTokenType): OSErr;
    VAR
        err, nmedia, mx: integer;
        actSize: Size;
        wantedName, sss: str255;
        wantedIndex: longint;
        obj: CObject;
        found: Boolean;
        docToken: MyTokenType;
        doc: KTHISAPPDoc;
        listOfRows: CList;
        thisRow: KRow;
    PROCEDURE Bail (bailErr: integer);
        BEGIN
            DocObjectAccessor := bailErr;
            EXIT(DocObjectAccessor);
        END;
    BEGIN
        IF NOT GetTokenFromAEDesc('D', containerToken, docToken) THEN
            Bail(eContainerDoesNotHaveValidToken);

        IF desiredClass = 'crow' THEN
            {good}
        ELSE
            Bail(eContainerDoesNotContainRequestedClass);

        doc := KTHISAPPDoc(docToken.theObject);
        listOfRows := doc.listOfRows;
        nmedia := listOfRows.GetNumItems;
        found := FALSE;

        IF keyForm = formName THEN
            BEGIN
                IF CatchErr(TextDescToStr(keyData, wantedName, actSize), 1915, err) THEN
                    Bail(err);
                FOR mx := 1 TO nmedia DO
                    BEGIN
                        thisRow := KRow(listOfRows.NthItem(mx));
                        IF thisRow.title^^ = wantedName THEN    {GET DESIRED ROW, BY NAME}
                            BEGIN
                                found := TRUE;
                                LEAVE;
                            END;
                    END;
            END

        ELSE IF keyForm = formAbsolutePosition THEN
            BEGIN
                wantedIndex := LongHandle(keyData.dataHandle)^^;
                IF keyData.descriptorType = typeLongInteger THEN
                    BEGIN
                        IF wantedIndex <= 0 THEN
                            wantedIndex := nmedia + wantedIndex + 1;
                    END
                ELSE IF keyData.descriptorType = typeAbsoluteOrdinal THEN
                    BEGIN
                        IF wantedIndex = LONGINT(kAEFirst) THEN
                            wantedIndex := 1
                        ELSE IF wantedIndex = LONGINT(kAELast) THEN
                            wantedIndex := nmedia
                        ELSE
                            Bail(eOnlyFirstOrLast);
                    END
                ELSE
                    Bail(eOnlyNameIndexFirstOrLast);

                IF (wantedIndex < 1) | (wantedIndex > nmedia) THEN
                    Bail(eIndexNumberOutOfRange);

                thisRow := KRow(listOfRows.NthItem(wantedIndex));    {GET DESIRED ROW, BY INDEX}
                found := TRUE;
            END
        ELSE
            Bail(eOnlyNameIndexFirstOrLast);

        IF found THEN
            BEGIN
                theTokenBody.myTokenCode := rowTokenCode;
                theTokenBody.theObject := CObject(thisRow);
                theTokenBody.subReference := 0;
                theTokenBody.isAProperty := FALSE;
                Bail(noErr);
            END
        ELSE
            Bail(errAENoSuchObject);
    END;


FUNCTION PropertyAccessor (desiredClass: DescType; containerToken: AEDesc; keyData: AEDesc; VAR theTokenBody: MyTokenType): OSErr;
    VAR
        item: integer;
        siz: longint;
        propertyCode: DescType;
    PROCEDURE Bail (bailErr: integer);
        BEGIN
            PropertyAccessor := bailErr;
            EXIT(PropertyAccessor);
        END;
    BEGIN
        IF containerToken.descriptorType = typeNull THEN
            BEGIN    {container is the app (which doesn't have a token of its own), so make a token for the property}
                theTokenBody.myTokenCode := typeNull;
                theTokenBody.theObject := NIL;
                theTokenBody.subReference := 0;
            END
        ELSE IF NOT GetTokenFromAEDesc('P', containerToken, theTokenBody) THEN
            Bail(eContainerDoesNotHaveValidToken);

        BlockMove(keyData.dataHandle^, @propertyCode, 4);

        theTokenBody.isAProperty := TRUE;
        theTokenBody.propertyCode := propertyCode;
        PropertyAccessor := noErr;
    END;


FUNCTION MyObjectAccessor (desiredClass: DescType; containerToken: AEDesc; containerClass: DescType; {}
                                keyForm: DescType; keyData: AEDesc; {}
                                VAR theToken: AEDesc; theRefCon: longint): OSErr;
    VAR
        err, item: integer;
    BEGIN
{$IFC CHATTY}
        ParamText(containerClass, desiredClass, keyForm, N2S(theRefCon));
        item := NoteAlert(7501, NIL);
{$ENDC}

        {if formPropertyID, we need to identify a specific property of the given object}

        IF keyForm = formPropertyID THEN
            err := PropertyAccessor(desiredClass, containerToken, keyData, aTokenBody)

        {otherwise, we are looking for an object "contained" in the given object}

        ELSE IF containerClass = typeNull THEN
            err := AppObjectAccessor(desiredClass, containerToken, keyForm, keyData, aTokenBody)
        ELSE IF containerClass = 'docu' THEN
            err := DocObjectAccessor(desiredClass, containerToken, keyForm, keyData, aTokenBody)
        {*** ADD SUPPORT FOR MORE CLASSES HERE, as needed ***)
        ELSE
            err := errAECantHandleClass;

        IF err = noErr THEN
            err := AECreateDesc(desiredClass, @aTokenBody, myTokenSize, theToken);
        MyObjectAccessor := err;
    END;

{------------------------------------------------------------------------------------------------}

FUNCTION MyCounter (desiredClass: DescType; containerDesc: AEDesc; VAR num: longint): OSErr;
    VAR
        myToken: MyTokenType;
        w: WindowPeek;
        numDoc, numWin, err, item: integer;
        obj, containerObject: CObject;
    BEGIN
{$IFC CHATTY}
        ParamText('MyCounter, containerDesc=“', containerDesc.descriptorType, '”', '');
        item := NoteAlert(7500, NIL);
{$ENDC}

        num := 0;
        IF containerDesc.descriptorType = typeNull THEN
            BEGIN    {container is the app (which doesn't have a token of its own)}
                myToken.myTokenCode := typeNull;
                myToken.theObject := NIL;
                myToken.subReference := 0;
            END
        ELSE IF NOT GetTokenFromAEDesc('C', containerDesc, myToken) THEN
            BEGIN
                MyCounter := eContainerDoesNotHaveValidToken;
                EXIT(MyCounter);
            END;

    {DOCUMENTS and WINDOWS}
        IF (desiredClass = 'docu') | (desiredClass = 'cwin') THEN
            BEGIN
                numDoc := 0;
                numWin := 0;
                w := WindowPeek(FrontWindow);
                WHILE w <> NIL DO
                    IF w^.windowKind = OBJ_WINDOW_KIND THEN
                        BEGIN
                            obj := CWindow(GetWRefCon(WindowPtr(w)));
                            numWin := numWin + 1;
                            IF Member(CBureaucrat(obj).itsSupervisor, KTHISAPPDoc) THEN
                                numDoc := numDoc + 1;
                            w := w^.nextWindow;
                        END;
                IF desiredClass = 'docu' THEN
                    num := numDoc
                ELSE IF desiredClass = 'cwin' THEN
                    num := numWin;
                err := noErr;
            END

    {ROWS}
        ELSE IF desiredClass = 'crow' THEN
            BEGIN
                containerObject := myToken.theObject;
                IF Member(containerObject, KTHISAPPDoc) THEN
                    BEGIN
                        IF KTHISAPPDoc(containerObject).listOfRows = NIL THEN
                            num := 0
                        ELSE
                            num := KTHISAPPDoc(containerObject).listOfRows.GetNumItems;
                        err := noErr;
                    END
                ELSE
                    err := eElementIsNotMemberOfSpecifiedContainer;
            END

    {UNKNOWN}
        ELSE
            err := errAECantHandleClass;

        MyCounter := err;
    END;


FUNCTION CountCallback (desiredClass: DescType; containerClass: DescType; containerToken: AEDesc; VAR num: longint): OSErr;
    VAR
        item: integer;
    BEGIN
{$IFC CHATTY}
        ParamText('CountCallback for container class=', containerClass, ' and type=', containerToken.descriptorType);
        item := NoteAlert(7500, NIL);
{$ENDC}

        CountCallback := MyCounter(desiredClass, containerToken, num);
    END;


FUNCTION HandleCountElements (theAppleEvent: AppleEvent; reply: AppleEvent; handlerRefCon: LongInt): OSErr;
    LABEL
        9;
    VAR
        myErr: OSErr;
        myDirObj, newDesc: AEDesc;
        myClass: DescType;
        myCount: LongInt;
        myToken: MyTokenType;
        item: integer;
    BEGIN
        PreHandler;
        myErr := errAEEventNotHandled;
        myDirObj := gNullDesc;

  { pick up direct object, which is the container in which things are to be counted }
        IF CatchErr(AEGetParamDesc(theAppleEvent, keyDirectObject, typeWildCard, myDirObj), 17913, myErr) THEN
            GOTO 9;

{$IFC CHATTY}
        ParamText('HandleCountElements, the direct object (container) is type “', myDirObj.descriptorType, '”', '');
        item := NoteAlert(7500, NIL);
{$ENDC}

    {RESOLVE}
        IF myDirObj.descriptorType = typeObjectSpecifier THEN
            BEGIN
                IF CatchErr(AEResolve(myDirObj, kAEIDoMinimum, newDesc), 17914, myErr) THEN
                    GOTO 9;
{$IFC CHATTY}
                ParamText('We resolved this to type “', newDesc.descriptorType, '”', '');
                item := NoteAlert(7500, NIL);
{$ENDC}
            END
        ELSE
            newDesc := myDirObj;
{ BlockMove(newDesc.dataHandle^, @myToken, myTokenSize); }

  { now the class of objects to be counted }
        IF CatchErr(AEGetParamPtr(theAppleEvent, keyAEObjectClass, typeType, gReturnedType, @myClass, SizeOf(myClass), gActSize), 17915, myErr) THEN
            GOTO 9;

  { missing any parameters? }
        IF CatchErr(GotRequiredParams(theAppleEvent), 17916, myErr) THEN
            GOTO 9;

  { now count }
        IF CatchErr(MyCounter(myClass, newDesc, myCount), 17917, myErr) THEN        {myDirObj? newDesc?}
            GOTO 9;

  { add result to reply }
        IF reply.descriptorType <> typeNull THEN
            gTempBool := CatchErr(AEPutParamPtr(reply, keyDirectObject, typeLongInteger, @myCount, SizeOf(myCount)), 17918, myErr);

9:    { finish up }

        gTempBool := CheckErr(AEDisposeDesc(myDirObj), 17919);

        HandleCountElements := myErr;
        PostHandler(reply, myErr);
    END;

{------------------------------------------------------------------------------------------------}

{We have received a message from BASIC}

FUNCTION MessageFromBasic (theAppleEvent: AppleEvent; reply: AppleEvent; handlerRefCon: LongInt): OSErr;
    VAR
        desiredClass: DescType;
        containerToken: AEDesc;
        containerClass: DescType;
        keyForm: DescType;
        keyData: AEDesc;
        theToken: AEDesc;
        theRefCon: longint;
        err: integer;
    BEGIN
        MessageFromBasic := 1234;    {an obvious err code for now}

        IF FALSE THEN
            err := MyObjectAccessor(desiredClass, containerToken, containerClass, keyForm, keyData, theToken, theRefCon);
    END;

{------------------------------------------------------------------------------------------------}

PROCEDURE KTHISAPPApp.InstallScriptHandlers;
    BEGIN
        gInHandler := FALSE;

        {This app is written under TCL, which checks for presence of AppleEvents.}
        {This method is only called if we know that AppleEvents are kopa setic.}

{Horrible things happen if we try to run under Symantec Think environment and use scripting, so don't try}
{$IFC NOT TCL_DEBUG}
        {create a "null descriptor" to serve as a default container}
        gNullDesc.descriptorType := typeNull;
        gNullDesc.dataHandle := NIL;

        gErrorDesc := gNullDesc;

        gTempBool := CheckErr(AEInstallEventHandler(kAECoreSuite, kAEGetData, @HandleGetData, 0, FALSE), 1020);
        gTempBool := CheckErr(AEInstallEventHandler(kAECoreSuite, kAESetData, @HandleSetData, 0, FALSE), 1021);
        gTempBool := CheckErr(AEInstallEventHandler(kAECoreSuite, kAECountElements, @HandleCountElements, 0, FALSE), 1022);

        gTempBool := CheckErr(AEObjectInit, 1030);
        gTempBool := CheckErr(AEInstallObjectAccessor(cProperty, typeNull, @MyObjectAccessor, 0, FALSE), 1031);
        gTempBool := CheckErr(AEInstallObjectAccessor(typeWildCard, typeWildCard, @MyObjectAccessor, 1, FALSE), 1032);

        gTempBool := CheckErr(AESetObjectCallbacks(NIL, @CountCallback, NIL, NIL, NIL, NIL, NIL), 1033);
{$ENDC}
    END;


END.